home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / modes / modula2.el < prev    next >
Encoding:
Text File  |  1995-01-31  |  12.2 KB  |  442 lines
  1. ;;; modula2.el --- Modula-2 editing support package
  2. ;; Keywords: languages
  3.  
  4. ; Author Mick Jordan
  5. ; amended Peter Robinson
  6. ; ported to GNU Michael Schmidt
  7. ;;;From: "Michael Schmidt" <michael@pbinfo.UUCP>
  8. ;;;Modified by Tom Perrine <Perrin@LOGICON.ARPA> (TEP)
  9.  
  10.  
  11. ;;; Added by TEP
  12. (defvar m2-mode-syntax-table nil
  13.   "Syntax table in use in Modula-2-mode buffers.")
  14.  
  15. (defvar m2-compile-command "m2c"
  16.   "Command to compile Modula-2 programs")
  17.  
  18. (defvar m2-link-command "m2l"
  19.   "Command to link Modula-2 programs")
  20.  
  21. (defvar m2-link-name nil
  22.   "Name of the executable.")
  23.  
  24.  
  25. (if m2-mode-syntax-table
  26.     ()
  27.   (let ((table (make-syntax-table)))
  28.     (modify-syntax-entry ?\\ "\\" table)
  29.     (modify-syntax-entry ?\( ". 1" table)
  30.     (modify-syntax-entry ?\) ". 4" table)
  31.     (modify-syntax-entry ?* ". 23" table)
  32.     (modify-syntax-entry ?+ "." table)
  33.     (modify-syntax-entry ?- "." table)
  34.     (modify-syntax-entry ?= "." table)
  35.     (modify-syntax-entry ?% "." table)
  36.     (modify-syntax-entry ?< "." table)
  37.     (modify-syntax-entry ?> "." table)
  38.     (modify-syntax-entry ?\' "\"" table)
  39.     (setq m2-mode-syntax-table table)))
  40.  
  41. ;;; Added by TEP
  42. (defvar m2-mode-map nil
  43.   "Keymap used in Modula-2 mode.")
  44.  
  45. (if m2-mode-map ()
  46.   (let ((map (make-sparse-keymap)))
  47.     (define-key map "\^i" 'm2-tab)
  48.     (define-key map "\C-cb" 'm2-begin)
  49.     (define-key map "\C-cc" 'm2-case)
  50.     (define-key map "\C-cd" 'm2-definition)
  51.     (define-key map "\C-ce" 'm2-else)
  52.     (define-key map "\C-cf" 'm2-for)
  53.     (define-key map "\C-ch" 'm2-header)
  54.     (define-key map "\C-ci" 'm2-if)
  55.     (define-key map "\C-cm" 'm2-module)
  56.     (define-key map "\C-cl" 'm2-loop)
  57.     (define-key map "\C-co" 'm2-or)
  58.     (define-key map "\C-cp" 'm2-procedure)
  59.     (define-key map "\C-c\C-w" 'm2-with)
  60.     (define-key map "\C-cr" 'm2-record)
  61.     (define-key map "\C-cs" 'm2-stdio)
  62.     (define-key map "\C-ct" 'm2-type)
  63.     (define-key map "\C-cu" 'm2-until)
  64.     (define-key map "\C-cv" 'm2-var)
  65.     (define-key map "\C-cw" 'm2-while)
  66.     (define-key map "\C-cx" 'm2-export)
  67.     (define-key map "\C-cy" 'm2-import)
  68.     (define-key map "\C-c{" 'm2-begin-comment)
  69.     (define-key map "\C-c}" 'm2-end-comment)
  70.     (define-key map "\C-j"  'm2-newline)
  71.     (define-key map "\C-c\C-z" 'suspend-emacs)
  72.     (define-key map "\C-c\C-v" 'm2-visit)
  73.     (define-key map "\C-c\C-t" 'm2-toggle)
  74.     (define-key map "\C-c\C-l" 'm2-link)
  75.     (define-key map "\C-c\C-c" 'm2-compile)
  76.     (setq m2-mode-map map)))
  77.  
  78. (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
  79.   
  80. ;;;###autoload
  81. (defun modula-2-mode ()
  82. "This is a mode intended to support program development in Modula-2.
  83. All control constructs of Modula-2 can be reached by typing
  84. Control-C followed by the first character of the construct.
  85. \\{m2-mode-map}
  86.   Control-c b begin         Control-c c case
  87.   Control-c d definition    Control-c e else
  88.   Control-c f for           Control-c h header
  89.   Control-c i if            Control-c m module
  90.   Control-c l loop          Control-c o or
  91.   Control-c p procedure     Control-c Control-w with
  92.   Control-c r record        Control-c s stdio
  93.   Control-c t type          Control-c u until
  94.   Control-c v var           Control-c w while
  95.   Control-c x export        Control-c y import
  96.   Control-c { begin-comment Control-c } end-comment
  97.   Control-c Control-z suspend-emacs     Control-c Control-t toggle
  98.   Control-c Control-c compile           Control-x ` next-error
  99.   Control-c Control-l link
  100.  
  101.    m2-indent controls the number of spaces for each indentation.
  102.    m2-compile-command holds the command to compile a Modula-2 program.
  103.    m2-link-command holds the command to link a Modula-2 program."
  104.   (interactive)
  105.   (kill-all-local-variables)
  106.   (use-local-map m2-mode-map)
  107.   (setq major-mode 'modula-2-mode)
  108.   (setq mode-name "Modula-2")
  109.   (make-local-variable 'comment-column)
  110.   (setq comment-column 41)
  111.   (make-local-variable 'end-comment-column)
  112.   (setq end-comment-column 75)
  113.   (set-syntax-table m2-mode-syntax-table)
  114.   (make-local-variable 'paragraph-start)
  115.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  116.   (make-local-variable 'paragraph-separate)
  117.   (setq paragraph-separate paragraph-start)
  118.   (make-local-variable 'paragraph-ignore-fill-prefix)
  119.   (setq paragraph-ignore-fill-prefix t)
  120. ;  (make-local-variable 'indent-line-function)
  121. ;  (setq indent-line-function 'c-indent-line)
  122.   (make-local-variable 'require-final-newline)
  123.   (setq require-final-newline t)
  124.   (make-local-variable 'comment-start)
  125.   (setq comment-start "(* ")
  126.   (make-local-variable 'comment-end)
  127.   (setq comment-end " *)")
  128.   (make-local-variable 'comment-column)
  129.   (setq comment-column 41)
  130.   (make-local-variable 'comment-start-skip)
  131.   (setq comment-start-skip "/\\*+ *")
  132.   (make-local-variable 'comment-indent-hook)
  133.   (setq comment-indent-hook 'c-comment-indent)
  134.   (make-local-variable 'parse-sexp-ignore-comments)
  135.   (setq parse-sexp-ignore-comments t)
  136.   (run-hooks 'm2-mode-hook))
  137.  
  138. (defun m2-newline ()
  139.   "Insert a newline and indent following line like previous line."
  140.   (interactive)
  141.   (let ((hpos (current-indentation)))
  142.     (newline)
  143.     (indent-to hpos)))
  144.  
  145. (defun m2-tab ()
  146.   "Indent to next tab stop."
  147.   (interactive)
  148.   (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
  149.  
  150. (defun m2-begin ()
  151.   "Insert a BEGIN keyword and indent for the next line."
  152.   (interactive)
  153.   (insert "BEGIN")
  154.   (m2-newline)
  155.   (m2-tab))
  156.  
  157. (defun m2-case ()
  158.   "Build skeleton CASE statment, prompting for the <expression>."
  159.   (interactive)
  160.   (let ((name (read-string "Case-Expression: ")))
  161.     (insert "CASE " name " OF")
  162.     (m2-newline)
  163.     (m2-newline)
  164.     (insert "END (* case " name " *);"))
  165.   (end-of-line 0)
  166.   (m2-tab))
  167.  
  168. (defun m2-definition ()
  169.   "Build skeleton DEFINITION MODULE, prompting for the <module name>."
  170.   (interactive)
  171.   (insert "DEFINITION MODULE ")
  172.   (let ((name (read-string "Name: ")))
  173.     (insert name ";\n\n\n\nEND " name ".\n"))
  174.   (previous-line 3))
  175.  
  176. (defun m2-else ()
  177.   "Insert ELSE keyword and indent for next line."
  178.   (interactive)
  179.   (m2-newline)
  180.   (backward-delete-char-untabify m2-indent ())
  181.   (insert "ELSE")
  182.   (m2-newline)
  183.   (m2-tab))
  184.  
  185. (defun m2-for ()
  186.   "Build skeleton FOR loop statment, prompting for the loop parameters."
  187.   (interactive)
  188.   (insert "FOR ")
  189.   (let ((name (read-string "Loop Initialiser: ")) limit by)
  190.     (insert name " TO ")
  191.     (setq limit (read-string "Limit: "))
  192.     (insert limit)
  193.     (setq by (read-string "Step: "))
  194.     (if (not (string-equal by ""))
  195.     (insert " BY " by))
  196.     (insert " DO")
  197.     (m2-newline)
  198.     (m2-newline)
  199.     (insert "END (* for " name " to " limit " *);"))
  200.   (end-of-line 0)
  201.   (m2-tab))
  202.  
  203. (defun m2-header ()
  204.   "Insert a comment block containing the module title, author, etc."
  205.   (interactive)
  206.   (insert "(*\n    Title: \t")
  207.   (insert (read-string "Title: "))
  208.   (insert "\n    Created:\t")
  209.   (insert (current-time-string))
  210.   (insert "\n    Author: \t")
  211.   (insert (user-full-name))
  212.   (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
  213.   (insert "*)\n\n"))
  214.  
  215. (defun m2-if ()
  216.   "Insert skeleton IF statment, prompting for <boolean-expression>."
  217.   (interactive)
  218.   (insert "IF ")
  219.   (let ((thecondition (read-string "<boolean-expression>: ")))
  220.     (insert thecondition " THEN")
  221.     (m2-newline)
  222.     (m2-newline)
  223.     (insert "END (* if " thecondition " *);"))
  224.   (end-of-line 0)
  225.   (m2-tab))
  226.  
  227. (defun m2-loop ()
  228.   "Build skeleton LOOP (with END)."
  229.   (interactive)
  230.   (insert "LOOP")
  231.   (m2-newline)
  232.   (m2-newline)
  233.   (insert "END (* loop *);")
  234.   (end-of-line 0)
  235.   (m2-tab))
  236.  
  237. (defun m2-module ()
  238.   "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
  239.   (interactive)
  240.   (insert "IMPLEMENTATION MODULE ")
  241.   (let ((name (read-string "Name: ")))
  242.     (insert name ";\n\n\n\nEND " name ".\n")
  243.     (previous-line 3)
  244.     (m2-header)
  245.     (m2-type)
  246.     (newline)
  247.     (m2-var)
  248.     (newline)
  249.     (m2-begin)
  250.     (m2-begin-comment)
  251.     (insert " Module " name " Initialisation Code "))
  252.   (m2-end-comment)
  253.   (newline)
  254.   (m2-tab))
  255.  
  256. (defun m2-or ()
  257.   (interactive)
  258.   (m2-newline)
  259.   (backward-delete-char-untabify m2-indent)
  260.   (insert "|")
  261.   (m2-newline)
  262.   (m2-tab))
  263.  
  264. (defun m2-procedure ()
  265.   (interactive)
  266.   (insert "PROCEDURE ")
  267.   (let ((name (read-string "Name: " ))
  268.     args)
  269.     (insert name " (")
  270.     (insert (read-string "Arguments: ") ")")
  271.     (setq args (read-string "Result Type: "))
  272.     (if (not (string-equal args ""))
  273.     (insert " : " args))
  274.     (insert ";")
  275.     (m2-newline)
  276.     (insert "BEGIN")
  277.     (m2-newline)
  278.     (m2-newline)
  279.     (insert "END ")
  280.     (insert name)
  281.     (insert ";")
  282.     (end-of-line 0)
  283.     (m2-tab)))
  284.  
  285. (defun m2-with ()
  286.   (interactive)
  287.   (insert "WITH ")
  288.   (let ((name (read-string "Record-Type: ")))
  289.     (insert name)
  290.     (insert " DO")
  291.     (m2-newline)
  292.     (m2-newline)
  293.     (insert "END (* with " name " *);"))
  294.   (end-of-line 0)
  295.   (m2-tab))
  296.  
  297. (defun m2-record ()
  298.   (interactive)
  299.   (insert "RECORD")
  300.   (m2-newline)
  301.   (m2-newline)
  302.   (insert "END (* record *);")
  303.   (end-of-line 0)
  304.   (m2-tab))
  305.  
  306. (defun m2-stdio ()
  307.   (interactive)
  308.   (insert "
  309. >FROM TextIO IMPORT 
  310.    WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
  311.    WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
  312.    WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
  313.    WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
  314.    WriteString, ReadString, WhiteSpace, EndOfLine;
  315.  
  316. >FROM SysStreams IMPORT sysIn, sysOut, sysErr;
  317.  
  318. "))
  319.  
  320. (defun m2-type ()
  321.   (interactive)
  322.   (insert "TYPE")
  323.   (m2-newline)
  324.   (m2-tab))
  325.  
  326. (defun m2-until ()
  327.   (interactive)
  328.   (insert "REPEAT")
  329.   (m2-newline)
  330.   (m2-newline)
  331.   (insert "UNTIL ")
  332.   (insert (read-string "<boolean-expression>: ") ";")
  333.   (end-of-line 0)
  334.   (m2-tab))
  335.  
  336. (defun m2-var ()
  337.   (interactive)
  338.   (m2-newline)
  339.   (insert "VAR")
  340.   (m2-newline)
  341.   (m2-tab))
  342.  
  343. (defun m2-while ()
  344.   (interactive)
  345.   (insert "WHILE ")
  346.   (let ((name (read-string "<boolean-expression>: ")))
  347.     (insert name " DO" )
  348.     (m2-newline)
  349.     (m2-newline)
  350.     (insert "END (* while " name " *);"))
  351.   (end-of-line 0)
  352.   (m2-tab))
  353.  
  354. (defun m2-export ()
  355.   (interactive)
  356.   (insert "EXPORT QUALIFIED "))
  357.  
  358. (defun m2-import ()
  359.   (interactive)
  360.   (insert "FROM ")
  361.   (insert (read-string "Module: "))
  362.   (insert " IMPORT "))
  363.  
  364. (defun m2-begin-comment ()
  365.   (interactive)
  366.   (if (not (bolp))
  367.       (indent-to comment-column 0))
  368.   (insert "(*  "))
  369.  
  370. (defun m2-end-comment ()
  371.   (interactive)
  372.   (if (not (bolp))
  373.       (indent-to end-comment-column))
  374.   (insert "*)"))
  375.  
  376. (defun m2-compile ()
  377.   (interactive)
  378.   (setq modulename (buffer-name))
  379.   (compile (concat m2-compile-command " " modulename)))
  380.  
  381. (defun m2-link ()
  382.   (interactive)
  383.   (setq modulename (buffer-name))
  384.   (if m2-link-name
  385.       (compile (concat m2-link-command " " m2-link-name))
  386.     (compile (concat m2-link-command " "
  387.              (setq m2-link-name (read-string "Name of executable: "
  388.                              modulename))))))
  389.  
  390. (defun execute-monitor-command (command)
  391.   (let* ((shell shell-file-name)
  392.      (csh (equal (file-name-nondirectory shell) "csh")))
  393.     (call-process shell nil t t "-cf" (concat "exec " command))))
  394.  
  395. (defun m2-visit ()
  396.   (interactive)
  397.   (let ((deffile nil)
  398.     (modfile nil)
  399.     modulename)
  400.     (save-excursion
  401.       (setq modulename
  402.         (read-string "Module name: "))
  403.       (switch-to-buffer "*Command Execution*")
  404.       (execute-monitor-command (concat "m2whereis " modulename))
  405.       (goto-char (point-min))
  406.       (condition-case ()
  407.       (progn (re-search-forward "\\(.*\\.def\\) *$")
  408.          (setq deffile (buffer-substring (match-beginning 1)
  409.                          (match-end 1))))
  410.     (search-failed ()))
  411.       (condition-case ()
  412.       (progn (re-search-forward "\\(.*\\.mod\\) *$")
  413.          (setq modfile (buffer-substring (match-beginning 1)
  414.                          (match-end 1))))
  415.     (search-failed ()))
  416.       (if (not (or deffile modfile))
  417.       (error "I can find neither definition nor implementation of %s"
  418.          modulename)))
  419.     (cond (deffile
  420.         (find-file deffile)
  421.         (if modfile
  422.         (save-excursion
  423.           (find-file modfile))))
  424.       (modfile
  425.        (find-file modfile)))))
  426.  
  427. (defun m2-toggle ()
  428.   "Toggle between .mod and .def files for the module."
  429.   (interactive)
  430.   (cond ((string-equal (substring (buffer-name) -4) ".def")
  431.      (find-file-other-window
  432.       (concat (substring (buffer-name) 0 -4) ".mod")))
  433.     ((string-equal (substring (buffer-name) -4) ".mod")
  434.      (find-file-other-window
  435.       (concat (substring (buffer-name) 0 -4)  ".def")))
  436.     ((string-equal (substring (buffer-name) -3) ".mi")
  437.      (find-file-other-window
  438.       (concat (substring (buffer-name) 0 -3)  ".md")))
  439.     ((string-equal (substring (buffer-name) -3) ".md")
  440.      (find-file-other-window
  441.       (concat (substring (buffer-name) 0 -3)  ".mi")))))
  442.